// RealPlay Ltd  copyrights.
// This program is Open Source AsIs
// You may use it for all purposes, including commercial
// But!!!
// If you use any part of this code, you must state clearly
// both in your source file and in the Help|about of your program,
// that the origin program or code was built by RealPlay Ltd

// ***********************************************************************/
// *                                                                     */
// *     This unit is the Work Area frame for  "Paint" Program           */
// *                                                                     */
// ***********************************************************************/

unit UPFrWorkArea;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls,
  UPZact,
  UPUtil,
  UPSel,
  UPFrSel, ImgList, StdCtrls;

type
  TFrameWorkArea = class(TFrame)
    WorkArea: TScrollBox;
    ImPanel: TPanel;
    Im: TImage;
    ImBottomPanel: TPanel;
    PBluedot: TPanel;
    IMRightPanel: TPanel;
    GrDot: TImage;
    ImageListBrush: TImageList;
    TimerSpray: TTimer;
    PBlue: TPanel;
    PBlueLeft: TPanel;
    Panel1: TPanel;
    procedure ImMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ImMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure resizeMouseMoveNS(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure resizeMouseMoveNWSE(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure resizeMouseMoveWE(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure SizeMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SizeMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GrDotMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure TimerSprayTimer(Sender: TObject);
  Private
    { Private declarations }
    TmpPen: Tpen;
    MSizeX, MSizeY: Integer; // Mouse Size Panel move
    EndX, EndY: Integer;
    BrushTool: TBitmap;
    MyPoints: TPointList;
    C_Nu: Integer; // the number of point for curve
    InPoly: boolean; // if we are in the midle (geeting new points) of painting a poligon now
    procedure contBrush(x1, y1, x2, y2: Integer);
  public
    { Public declarations }

    ImSelS: TSel;
    StartX, StartY: Integer;
    ZF: TZfifo;
    MyStat: Tstat;
    Procedure Clear;
    procedure init; // psedo onCreate
    procedure finish; // psedo onClose
  end;

const
  GDLen = 15; // Green Dot distance from sel area

implementation

uses math,
  UPMain, UPFloodfill, UPFrToolOptions;
{$R *.dfm}

procedure TFrameWorkArea.Clear;
begin
  MyPoints.Clear;
  InPoly := false;
  C_Nu := 0;
end;

procedure TFrameWorkArea.init; // psedo onCreate
begin
  MyPoints := TPointList.Create;
  Clear;
  Im.Canvas.Brush.Bitmap := nil; // to enable call to free with no check;
  ImSelS := TSel.Create(self);
  ImSelS.Picture.Bitmap.TransparentColor := $FFFEFF; // needs modification
  ImPanel.Doublebuffered := true;
  BrushTool := TBitmap.Create;
  TmpPen := Tpen.Create;
  if FPaint.tool = 0 then
    Im.Cursor := crPen
  else
    Im.Cursor := FPaint.tool;
  ZF := TZfifo.Create(30, Im);
  MyStat := Tstat.Create(self);
  MyStat.Cx := ZoomXr;
  MyStat.Cy := ZoomYr;
  GrDot.Cursor := crRotate;
  GrDot.BringToFront; // ImSel was initilaized on run time so he is infront of the dot
end;

procedure TFrameWorkArea.finish; // psedo onClose
begin
  MyPoints.Free;
  ImSelS.Free;
  TmpPen.Free;
  BrushTool.Free;
  ZF.Free;
  MyStat.Free;
end;

// **********************************************************************
// Mouse on Picture
// **********************************************************************
procedure TFrameWorkArea.ImMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);

var
  MyP: TPointArray;
  XPos, YPos: Integer;
begin
  ImSelS.PaintSel;
  StartX := trunc(X / ZoomXr);
  StartY := trunc(Y / ZoomYr);
  MyStat.X := StartX;
  MyStat.Y := StartY;
  Im.Canvas.MoveTo(StartX, StartY);
  if FPaint.tool = crErasor then
    Im.Canvas.Pen.Color := FPaint.FrColor1.Bc.Color
  else
    Im.Canvas.Pen.Color := FPaint.FrColor1.Pc.Color;
  case FPaint.tool of
    crBrush:
      begin
        BrushTool.width := 0; // clear;
        ImageListBrush.GetBitmap
          (FPaint.FrTools1.FrameToolOption1.BrushState - 1, BrushTool);
        drawtrans(BrushTool, Im.Picture.Bitmap, StartX - 6, StartY - 6,
          FPaint.FrColor1.Pc.Color)
      end;
    crCatchS:
      begin
        Im.Canvas.MoveTo(StartX, StartY);
        ImSelS.SelRectInit(StartX, StartY);
        TmpPen.Assign(Im.Canvas.Pen);
        Im.Canvas.Pen.Color := clblue + 1;
        Im.Canvas.Pen.width := 2;
        Im.Canvas.LineTo(StartX, StartY);
      end;
    crCatch:
      begin
        Im.Canvas.MoveTo(StartX, StartY);
        TmpPen.Assign(Im.Canvas.Pen);
        Im.Canvas.Pen.Color := clblue;
        Im.Canvas.Pen.width := 1;
        Im.Canvas.Pen.Style := psDot;
      end;
    crErasor:
      begin
        Im.Canvas.Pen.width := 6 *
          FPaint.FrTools1.FrameToolOption1.EraseSizeState;
        Im.Canvas.Pen.Color := FPaint.FrColor1.Bc.Color;
      end;
    crBin:
      begin
        UPFloodfill.Myfloodfill(StartX, StartY, Im.Canvas.Pixels[StartX,
          StartY], FPaint.FrColor1.Pc.Color, Im.Picture.Bitmap,
          UPFloodfill.Depth);
        MyStat.Changed := true;
      end;
    crPipet:
      FPaint.FrColor1.Pc.Color := Im.Canvas.Pixels[StartX, StartY];
    crMag:
      begin
        ImSelS.ClearSel;
        XPos := X - WorkArea.HorzScrollBar.Position;
        YPos := Y - WorkArea.VertScrollBar.Position;
        if (ssalt in Shift) or (ssCtrl in Shift) then
        begin
          ZoomYr := ZoomYr / Sqrt(2);
          ZoomXr := ZoomXr / Sqrt(2);
          X := round(X / Sqrt(2));
          Y := round(Y / Sqrt(2));
        end
        else if (ZoomYr < 8) and (ZoomXr < 8) then
        begin
          ZoomYr := ZoomYr * Sqrt(2);
          ZoomXr := ZoomXr * Sqrt(2);
          X := round(X * Sqrt(2));
          Y := round(Y * Sqrt(2));
        end;
        MyStat.SetSize;
        WorkArea.VertScrollBar.Position := Y - YPos;
        WorkArea.HorzScrollBar.Position := X - XPos;

      end;
    crPen:
      with Im.Picture.Bitmap.Canvas do
      begin
        Im.Canvas.Pen.width := FPaint.FrTools1.FrameToolOption1.LineState;
        Pixels[StartX, StartY] := FPaint.FrColor1.Pc.Color;
        LineTo(StartX, StartY);
      end;
    crSpray:
      begin
        TimerSpray.Enabled := true;
      end;
    crtext:
      ;
    crLine:
      begin
        Im.Canvas.MoveTo(StartX, StartY);
        Im.Canvas.Pen.Color := FPaint.FrColor1.Pc.Color;
        Im.Canvas.Pen.width := FPaint.FrTools1.FrameToolOption1.LineState;
      end;
    crCurve:
      begin
        Im.Canvas.MoveTo(StartX, StartY);
        Im.Canvas.Pen.Color := FPaint.FrColor1.Pc.Color;
        Im.Canvas.Pen.width := FPaint.FrTools1.FrameToolOption1.LineState;

        case C_Nu of
          0:
            Begin
              MyPoints.Clear;
              MyPoints.AddPoint(point(StartX, StartY));
              C_Nu := 1;
            end;
          2:
            begin
              ZF.GetF;
              MyPoints.delete(1);
              MyPoints.InsertPoint(1, point(StartX, StartY));
              Im.Canvas.PolyBezier(MyPoints.AsPointArray);
            end;
          3:
            begin
              ZF.GetF;
              MyPoints.delete(2);
              MyPoints.InsertPoint(2, point(StartX, StartY));
              setlength(MyP, 4); // the bug 3880
              MyP := MyPoints.AsPointArray; // the bug 3880
              Im.Canvas.PolyBezier(MyP);
              setlength(MyP, 0); // the bug 3880
              // Im.Canvas.PolyBezier(MyPoints.AsPointArray); //Causes an "Internal error C3880" Ido
            end;
        end;

      end;
    crRect, crCircle, crRectS, crCircleS:
      begin
        Im.Canvas.MoveTo(StartX, StartY);
        Im.Canvas.Pen.Color := FPaint.FrColor1.Pc.Color;
        Im.Canvas.Pen.width := FPaint.FrTools1.FrameToolOption1.LineState;
        Im.Canvas.Brush.Bitmap.Free;
        If (FPaint.tool = crRectS) then
        begin
          If not InPoly then
            MyPoints.Clear;
          InPoly := true;
          MyPoints.AddPoint(point(StartX, StartY));
          Im.Canvas.MoveTo(StartX, StartY);
          If MyPoints.count > 1 then
            Im.Canvas.Polyline(MyPoints.AsPointArray);
        end;
        Case FPaint.FrTools1.FrameToolOption1.RectState of
          toRect1:
            Im.Canvas.Brush.Style := bsClear;
          toRect2:
            begin
              Im.Canvas.Brush.Style := bsSolid;
              Im.Canvas.Brush.Color := FPaint.FrColor1.Bc.Color;
            end;
          toRect3:
            begin
              Im.Canvas.Brush.Style := bsSolid;
              Im.Canvas.Brush.Color := FPaint.FrColor1.Pc.Color;
            end;
        end; // case
      end;
    crTrans:
      begin
        Im.Picture.Bitmap.TransparentColor := Im.Canvas.Pixels[StartX, StartY];
        MyStat.Changed := true;
      end;
  end; // case
end;

// ********************************************
procedure TFrameWorkArea.ImMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  Nx, Ny, RoR: Integer;
begin
  Nx := trunc(X / ZoomXr);
  Ny := trunc(Y / ZoomYr);
  if ssLeft in Shift then
  begin
    case FPaint.tool of
      crRect:
        begin
          ZF.GetN;
          Im.Canvas.Rectangle(StartX, StartY, Nx, Ny);
        end;
      crRectS:
        begin
          ZF.GetN;
          If MyPoints.count > 1 then
          begin
            MyPoints.delete(MyPoints.count - 1);
            MyPoints.AddPoint(point(Nx, Ny));
            Im.Canvas.Polyline(MyPoints.AsPointArray);
          end
          else
          begin
            Im.Canvas.MoveTo(StartX, StartY);
            Im.Canvas.LineTo(Nx, Ny);
          end;
        end;
      crCircle:
        begin
          ZF.GetN;
          Im.Canvas.Ellipse(StartX, StartY, Nx, Ny);
        end;
      crCircleS:
        begin
          ZF.GetN;
          RoR := min(abs(Nx - StartX), abs(Ny - StartY)) div 4;
          Im.Canvas.RoundRect(StartX, StartY, Nx, Ny, RoR, RoR);
        end;
      crBrush:
        contBrush(Nx, Ny, MyStat.X, MyStat.Y);
      crErasor:
        Im.Canvas.LineTo(Nx, Ny);
      crCurve:
        begin
          ZF.GetN;
          Im.Canvas.MoveTo(StartX, StartY);
          case C_Nu of
            1:
              Im.Canvas.LineTo(Nx, Ny);
            2:
              begin
                MyPoints.delete(1);
                MyPoints.InsertPoint(2, point(Nx, Ny));
                Im.Canvas.PolyBezier(MyPoints.AsPointArray);
              end;
            3:
              begin
                MyPoints.delete(2);
                MyPoints.InsertPoint(2, point(Nx, Ny));
                Im.Canvas.PolyBezier(MyPoints.AsPointArray);
              end;
          end;
        end;
      crSpray:
        ;
      crPen:
        Im.Canvas.LineTo(Nx, Ny);
      crLine:
        begin
          ZF.GetN;
          Im.Canvas.MoveTo(StartX, StartY);
          Im.Canvas.LineTo(Nx, Ny);
        end;
      crCatch:
        begin
          ZF.GetN;
          Im.Canvas.MoveTo(StartX, StartY);
          Im.Canvas.LineTo(StartX, Ny);
          Im.Canvas.LineTo(Nx, Ny);
          Im.Canvas.LineTo(Nx, StartY);
          Im.Canvas.LineTo(StartX, StartY);
        end;
      crCatchS:
        begin
          ImSelS.SelRect(Nx, Ny);
          Im.Canvas.LineTo(Nx, Ny);
        end;
    end; // case
  end;
  MyStat.X := Nx;
  MyStat.Y := Ny;
end;

// ********************************************
procedure TFrameWorkArea.ImMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  EndX := trunc(X / ZoomXr);
  EndY := trunc(Y / ZoomYr);
  case FPaint.tool of
    crCatchS:
      begin
        Im.Canvas.LineTo(StartX, StartY);
        ImSelS.GetSelRect;
        ZF.GetN;
        Im.Canvas.Pen.Assign(TmpPen);
      end;
    crCatch:
      begin
        ZF.GetN;
        if (abs(StartX - EndX) > 4) and (abs(StartY - EndY) > 4) then
          ImSelS.GetSel(min(StartX, EndX), min(StartY, EndY),
            max(StartX, EndX) + 1, max(StartY, EndY) + 1);
        Im.Canvas.Pen.Assign(TmpPen);
      end;
    crBrush, crErasor, crPen, crLine, crtext, crRect, crCircle, crCircleS:
      begin
        MyStat.Changed := true;
      end;
    crCurve:
      begin
        case C_Nu of
          1:
            begin
              MyPoints.AddPoint(point(StartX, StartY));
              MyPoints.AddPoint(point(EndX, EndY));
              MyPoints.AddPoint(point(EndX, EndY));
            end;
          3:
            begin
              C_Nu := -1; // so it will be 0 after inc
              MyPoints.Clear;
            end;
        end;
        inc(C_Nu);
        MyStat.Changed := true;
      end;
    crRectS:
      begin
        ZF.GetN;
        if MyPoints.count = 1 then
          MyPoints.AddPoint(point(EndX, EndY));
        if max(abs(EndX - MyPoints[0].X), abs(EndY - MyPoints[0].Y)) < 4 then
        begin
          InPoly := false;
          If MyPoints.count > 2 then
            Im.Canvas.Polygon(MyPoints.AsPointArray);
          MyStat.Changed := true;
          MyPoints.Clear;
        end
        else If MyPoints.count > 1 then
          Im.Canvas.Polyline(MyPoints.AsPointArray);
      end;
    crSpray:
      begin
        TimerSpray.Enabled := false;
        MyStat.Changed := true;
      end;
  end; // case
end;

// ***********************************************************
procedure TFrameWorkArea.contBrush(x1, y1, x2, y2: Integer);
Var
  i: Integer;
begin
  drawtrans(BrushTool, Im.Picture.Bitmap, x1 - 6, y1 - 6,
    FPaint.FrColor1.Pc.Color);
  if max(abs(x1 - x2), abs(y1 - y2)) > 1 then
    with MyPoints do
    begin
      line(x1, y1, x2, y2);
      for i := 1 to count - 1 do
        drawtrans(BrushTool, Im.Picture.Bitmap, points[i].X - 6,
          points[i].Y - 6, FPaint.FrColor1.Pc.Color);
    end;
end;

// **********************************************
procedure TFrameWorkArea.TimerSprayTimer(Sender: TObject);
var
  r2, r, rr, i, X, Y: Integer;
begin
  r := (FPaint.FrTools1.FrameToolOption1.SprayState) * 8;
  r2 := r div 2;
  rr := sqr(r2);

  for i := 1 to r2 do
  begin
    X := random(r) - r2;
    Y := random(r) - r2;
    if (sqr(X) + sqr(Y)) < rr then
      Im.Canvas.Pixels[X + MyStat.X, Y + MyStat.Y] := FPaint.FrColor1.Pc.Color
  end;
  //
end;

// ********************************************
// Resize picture
// ********************************************
procedure TFrameWorkArea.resizeMouseMoveNS(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  yy: Integer;
begin
  if ssLeft in Shift then
  begin
    ImSelS.ClearSel;
    yy := Y - MSizeY;
    ImPanel.Height := ImPanel.Height + yy;
    if not((ssalt in Shift) or (ssCtrl in Shift)) then
      with Im.Picture.Bitmap do
        Height := Height + yy;
    ZoomYr := Im.Height / Im.Picture.Height;
    MyStat.Cy := ZoomYr;
    if ssCtrl in Shift then
      MyStat.Y := Im.Height
    else
      MyStat.Y := Im.Picture.Bitmap.Height;

    with WorkArea.VertScrollBar do
      if yy <= 0 then
        Margin := Margin - yy
      else
        Margin := 7;
  end;
end;

// ********************************************
procedure TFrameWorkArea.resizeMouseMoveWE(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  xx: Integer;
begin
  if (ssLeft in Shift) then
  begin
    ImSelS.ClearSel;
    xx := X - MSizeX;
    ImPanel.width := ImPanel.width + xx;
    if not((ssalt in Shift) or (ssCtrl in Shift)) then
      with Im.Picture.Bitmap do
        width := width + xx;
    ZoomXr := Im.width / Im.Picture.width;
    MyStat.Cx := ZoomXr;
    if ssCtrl in Shift then
      MyStat.X := Im.width
    else
      MyStat.X := Im.Picture.Bitmap.width;
    with WorkArea.HorzScrollBar do
      if xx <= 0 then
        Margin := Margin - xx
      else
        Margin := 10;
  end;
end;

// ********************************************
procedure TFrameWorkArea.resizeMouseMoveNWSE(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  resizeMouseMoveNS(Sender, Shift, X, Y);
  resizeMouseMoveWE(Sender, Shift, X, Y);
end;

// ********************************************
procedure TFrameWorkArea.SizeMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MSizeX := X;
  MSizeY := Y;
end;

// ********************************************

procedure TFrameWorkArea.SizeMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  bmp: TBitmap;
begin
  WorkArea.HorzScrollBar.Margin := 10;
  WorkArea.VertScrollBar.Margin := 7;
  with Im.Picture do
    If ssCtrl in Shift then
      if MessageDlg(
        'This is a distractive act!'#13'Are you sure yo want to Stretch?',
        mtWarning, [mbOk, mbCancel], 0) = mrok then
      begin
        bmp := TBitmap.Create;
        try
          bmp := TBitmap.Create;
          bmp.Assign(Bitmap);
          Bitmap.width := Im.width;
          Bitmap.Height := Im.Height;
          with Bitmap do
            Canvas.StretchDraw(rect(0, 0, width - 1, Height - 1), bmp);
        finally
          bmp.Free;
          ZoomXr := 1;
          ZoomYr := 1;
        end;
      end;
  MyStat.Changed := MyStat.Changed; // save current picture with out changing the state
end;

// ****************************************************
// mouse on green rotate
// ****************************************************

procedure TFrameWorkArea.GrDotMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  dx, dy: Integer;
begin
  if (ssLeft in Shift) then
  begin
    dx := ImSelS.screentoclient(mouse.CursorPos).X - (ImSelS.width div 2);
    dy := -ImSelS.screentoclient(mouse.CursorPos).Y + (ImSelS.Height div 2);
    if dy <> 0 then
      ImSelS.Degrees := round(180 / pi * arctan(dx / dy))
    else if dx > 0 then
      ImSelS.Degrees := 90
    else
      ImSelS.Degrees := 270;
    if dy < 0 then
      ImSelS.Degrees := ImSelS.Degrees + 180;
    ImSelS.Degrees := (360 + ImSelS.Degrees) mod 360;
    ImSelS.DrawRotate;
  end;
end;

end.
